perm filename SUBR2.F4[MUS,LCS] blob sn#166811 filedate 1975-07-06 generic text, type T, neo UTF8
00010	C  SUBR2.F4
00100	C  THIS SUBR. CAUSES A CHROM. SCALE ON BUZZ TONES WITHIN RAND. SEL.
00200	
00300	
00400		SUBROUTINE SUBR
00500		COMMON /INS/ INST(27),BG(60)
00600		COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
00700	C   INUM=INST#  IPAR=PARAM#  
00800	C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
00900	C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
01000	C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
01100	C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
01200	C   F1=86  F15=100 (NO F16!)
01300	
01400		IF(CNT(1).GT.1)GO TO 10
01500	C NEXT IS FOR INITIALIZATION OF VARIABLES
01600		K=25
01700	C  NOTE NUM OF C BELOW MIDDLE C.
01800		L=0
01900	C  TO STORE NOTE NUM FOR FOLLOWING TIME AROUND.
02000	
02100	10	J=P(3)
02200	C  PUTS P3 INTO INTEGER FORM.
02300	
02400		IF(J.NE.K)GO TO 20
02500	C  JUMP IF NOTE IS NOT ONE BEING LOOKED FOR.
02600	
02700		K=K+1
02800	C GET READY FOR NEXT 1/2 STEP.
02900	
03000		P(5)=87
03100	C NOTE WILL BE STACCATO (F2=85+2)
03200	
03300		P(6)=91
03400	C PUTS IN BUZZ'S TONE (F6=85+6)
03500	
03600		P(4)=1000
03700	C  MAKE IT LOUDER
03800	
03900		P(2)=.15
04000	C  MAKE IT LONGER
04100	
04200		GO TO 40
04300	
04400	20	IF(J.EQ.L)GO TO 30
04500	C  JUMP IF REPEATED NOTE.
04600	
04700	40	L=J
04800	C  STORES NOTE NUM IN L FOR NEXT TIME AROUND.
04900	
05000	
05100		IF(K.GT.37)DUR(1)=0
05200	C  WHEN BUZZ NOTE REACHES MID. C CAUSE ENDING BY
05300	C SETTING DURATION TO ZERO.
05400		RETURN
05500	
05600	30	L=L+2
05700	C  RAISES IT 2 1/2 STEPS IF IT WAS REPEATED NOTE.
05800		P(3)=L
05900	C  PUTS IT BACK IN P3.
06000		RETURN
06100		END
06200	
06300	C TYPICAL INPUT DATA
06400	
06500	C	TOOT 0 100; <TRUE END IS SET IN SUBROUTINE
06600	C	P2 .08;  P3 1 B3,D4;
06700	C	P4 200;
06800	C	P5 F1; P6 SUBL F3; END;